(**
 * The typed pattern calculus for the IML.
 * @copyright (C) 2021 SML# Development Team.
 * @author Atsushi Ohori
 * @author Liu Bochao
 * @version $Id: TypedCalc.ppg,v 1.36.6.7 2010/02/10 05:17:29 hiro-en Exp $
 *)
structure TypedCalc = struct

  local
    open SMLFormat.FormatExpression
    fun N0 x = [Guard (SOME {cut = true, strength = 0, direction = Neutral}, x)]
  in
  fun iftrue (x, y) true = x
    | iftrue (x, y) false = y
  fun ifsome (x, y) (SOME _) = x
    | ifsome (x, y) NONE = y
  fun ifcons (x, y) (_::_) = x
    | ifcons (x, y) nil = y
  fun ifsingle (x, y) [_] = x
    | ifsingle (x, y) _ = y
  fun N0ifnotsingle x [_] = x
    | N0ifnotsingle x _ = N0 x
  end

  (*%
    @prefix helper_
    @formatter(RecordLabel.label) RecordLabel.format_label
   *)
  type 'value RecordLabelMap =
      (*%
        @prefix helper_
        @format(field fields)
        fields(field)("," +1)
        @format:field(label * value)
        { label +d "=" 2[ +1 value ] }
       *)
      (RecordLabel.label * 'value) list

  val helper_RecordLabelMap =
      fn formatter => fn map =>
         helper_RecordLabelMap formatter (RecordLabel.Map.listItemsi map)

  type loc = Loc.loc

  (*%
    @formatter(Symbol.longsymbol) Symbol.format_longsymbol
   *)
  (*% @prefix formatWithType_
    @formatter(Symbol.longsymbol) Symbol.format_longsymbol
   *)
  type longsymbol = Symbol.longsymbol

  (*%
    @formatter(FFIAttributes.attributes) FFIAttributes.format_attributes
   *)
  (*% @prefix formatWithType_
    @formatter(FFIAttributes.attributes) FFIAttributes.format_attributes
   *)
  type ffiAttributes
    = (*%
        @format(x) x
       *)
      (*% @prefix formatWithType_
        @format(x) x
       *)
      FFIAttributes.attributes

  (*%
    @formatter(Types.ty) Types.format_ty
   *)
  (*% @prefix formatWithType_
    @formatter(Types.ty) Types.format_ty
   *)
  type ty
    = (*%
        @format(ty) ty
       *)
      (*% @prefix formatWithType_
        @format(ty) ty
       *)
      Types.ty

  (*%
    @formatter(Types.btvEnv) Types.format_btvEnv
   *)
  (*% @prefix formatWithType_
    @formatter(Types.btvEnv) Types.format_btvEnv
   *)
  type btvEnv
    = (*%
        @format(btv)
       *)
      (*% @prefix formatWithType_
        @format(btv) btv
       *)
      Types.btvEnv

  (*%
    @formatter(PatternCalc.caseKind) PatternCalc.format_caseKind
   *)
  (*% @prefix formatWithType_
    @formatter(PatternCalc.caseKind) PatternCalc.format_caseKind
   *)
  type caseKind
    = (*%
        @format(x) x
       *)
      (*% @prefix formatWithType_
        @format(x) x
       *)
      PatternCalc.caseKind

  (*%
    @formatter(AbsynConst.constant) AbsynConstFormatter.format_constant
   *)
  (*% @prefix formatWithType_
    @formatter(AbsynConst.constant) AbsynConstFormatter.format_constant
   *)
  type constant
    = (*%
        @format(x) x
       *)
      (*% @prefix formatWithType_
        @format(x) x
       *)
      AbsynConst.constant

  (*%
    @formatter(BuiltinPrimitive.primitive) BuiltinPrimitive.format_primitive
   *)
  (*% @prefix formatWithType_
    @formatter(BuiltinPrimitive.primitive) BuiltinPrimitive.format_primitive
   *)
  type primitive
    = (*%
        @format(x) x
       *)
      (*% @prefix formatWithType_
        @format(x) x
       *)
      BuiltinPrimitive.primitive

  (*%
    @formatter(Types.varInfo) Types.format_varInfo
   *)
  (*% @prefix formatWithType_
    @formatter(Types.varInfo) Types.formatWithType_varInfo
   *)
  type varInfo
    = (*%
        @format(var) var
       *)
      (*% @prefix formatWithType_
        @format(var) var
       *)
      Types.varInfo

  (*%
    @formatter(Types.exVarInfo) Types.format_exVarInfo
   *)
  (*% @prefix formatWithType_
    @formatter(Types.exVarInfo) Types.formatWithType_exVarInfo
   *)
  type exVarInfo
    = (*%
        @format(x) x
       *)
      (*% @prefix formatWithType_
        @format(x) x
       *)
      Types.exVarInfo

  (*%
    @formatter(Types.primInfo) Types.format_primInfo
   *)
  (*% @prefix formatWithType_
    @formatter(Types.primInfo) Types.formatWithType_primInfo
   *)
  type primInfo
    = (*%
        @format(x) x
       *)
      (*% @prefix formatWithType_
        @format(x) x
       *)
      Types.primInfo

  (*%
    @formatter(Types.oprimInfo) Types.format_oprimInfo
   *)
  (*% @prefix formatWithType_
    @formatter(Types.oprimInfo) Types.format_oprimInfo
   *)
  type oprimInfo
    = (*%
        @format(x) x
       *)
      (*% @prefix formatWithType_
        @format(x) x
       *)
      Types.oprimInfo

  (*%
    @formatter(Types.conInfo) Types.format_conInfo
   *)
  (*% @prefix formatWithType_
    @formatter(Types.conInfo) Types.format_conInfo
   *)
  type conInfo
    = (*%
        @format(con) con
       *)
      (*% @prefix formatWithType_
        @format(con) con
       *)
      Types.conInfo

  (*%
    @formatter(Types.exnInfo) Types.format_exnInfo
   *)
  (*% @prefix formatWithType_
    @formatter(Types.exnInfo) Types.format_exnInfo
   *)
  type exnInfo
    = (*%
        @format(x) x
       *)
      (*% @prefix formatWithType_
        @format(x) x
       *)
      Types.exnInfo

  (*%
    @formatter(Types.exExnInfo) Types.format_exExnInfo
   *)
  (*% @prefix formatWithType_
    @formatter(Types.exExnInfo) Types.format_exExnInfo
   *)
  type exExnInfo
    = (*%
        @format(x) x
       *)
      (*% @prefix formatWithType_
        @format(x) x
      *)
      Types.exExnInfo

  (*%
    @formatter(Types.varInfo) Types.format_varInfo
   *)
  (*% @prefix formatWithType_
    @formatter(Types.varInfo) Types.formatWithType_varInfo
   *)
  datatype idstatus
    = (*%
        @format(var) var
       *)
      (*% @prefix formatWithType_
        @format(var) var
       *)
      VARID of Types.varInfo
    | (*%
        @format(var * int) var
       *)
      (*% @prefix formatWithType_
        @format(var * int) "(rf" var ")"
       *)
      RECFUNID of Types.varInfo * int

  (*%
   *)
  (*% @prefix formatWithType_
   *)
  datatype exnCon
    = (*%
        @format(exn) exn
       *)
      (*% @prefix formatWithType_
        @format(exn) exn
       *)
      EXN of exnInfo
    | (*%
        @format(exn) exn
       *)
      (*% @prefix formatWithType_
        @format(exn) exn
       *)
      EXEXN of exExnInfo

  (*%
    @formatter(ifsome) ifsome
    @formatter(ifsingle) ifsingle
    @formatter(N0ifnotsingle) N0ifnotsingle
    @formatter(RecordLabel.label) RecordLabel.format_label
   *)
  (*% @prefix formatWithType_
    @formatter(ifsome) ifsome
    @formatter(ifsingle) ifsingle
    @formatter(N0ifnotsingle) N0ifnotsingle
    @formatter(RecordLabel.label) RecordLabel.format_label
   *)
  datatype ffiTy =
      (*%
        @format(attr * dom doms * var vars varsOpt * ran rans * loc)
        R4{
          doms:ifsingle()(varsOpt:ifsome()("(",),"(")
          doms:N0ifnotsingle()(doms(dom)("," +1))
          varsOpt:ifsome()("...(",)
          varsOpt:ifsome()(!N0{ varsOpt(vars(var)("," +1)) },)
          varsOpt:ifsome()(")",)
          doms:ifsingle()(varsOpt:ifsome()(")",),")")
          +1 "->" +d
          rans:ifsingle()(,"(")
          rans:N0ifnotsingle()(rans(ran)("," +1))
          rans:ifsingle()(,")")
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      FFIFUNTY of ffiAttributes option * ffiTy list * ffiTy list option
                  * ffiTy list * loc
    | (*%
        @format(field fields * loc)
        "{" !N0 { fields(field)("," +1) } "}"
        @format:field(label * ty)
        { label ":" 2[ +1 ty ] }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      (* field order is significant *)
      FFIRECORDTY of (RecordLabel.label * ffiTy) list * loc
    | (*%
        @format(ty * loc) ty
       *)
      (*% @prefix formatWithType_
        @format(ty * loc) ty
       *)
      FFIBASETY of ty * loc

  (*%
    @formatter(iftrue) iftrue
    @formatter(ifsome) ifsome
    @formatter(ifcons) ifcons
    @formatter(ifsingle) ifsingle
    @formatter(N0ifnotsingle) N0ifnotsingle
    @formatter(RecordLabel.Map.map) helper_RecordLabelMap
    @formatter(RecordLabel.label) RecordLabel.format_label
    @formatter(FunLocalLabel.id) FunLocalLabel.format_id
    @formatter(Types.constraint) Types.format_constraint
  *)
  (*% @prefix formatWithType_
    @formatter(iftrue) iftrue
    @formatter(ifsome) ifsome
    @formatter(ifcons) ifcons
    @formatter(ifsingle) ifsingle
    @formatter(N0ifnotsingle) N0ifnotsingle
    @formatter(RecordLabel.Map.map) helper_RecordLabelMap
    @formatter(RecordLabel.label) RecordLabel.format_label
    @formatter(FunLocalLabel.id) FunLocalLabel.format_id
    @formatter(Types.constraint) Types.format_constraint
    @formatter(format_varInfo) format_varInfo
    @formatter(format_exVarInfo) format_exVarInfo
   *)
  datatype tpexp
    = (*%
        @format "TPERROR"
       *)
      (*% @prefix formatWithType_
        @format "TPERROR"
       *)
      TPERROR
    | (*%
        @format({const, ty, loc})
        const
       *)
      (*% @prefix formatWithType_
        @format({const, ty, loc})
        L2{ const +1 ":" +d ty }
       *)
      TPCONSTANT of
      {
        const : constant,
        ty : ty,
        loc : loc
      }
    | (*%
        @format(var) var
       *)
      (*% @prefix formatWithType_
        @format(var) var:format_varInfo
       *)
      TPVAR of varInfo
    | (*%
        @format(var * loc) var
       *)
      (*% @prefix formatWithType_
        @format(var * loc) var:format_exVarInfo
       *)
      (* extnernal variable imported through _require *)
      TPEXVAR of (exVarInfo * loc)
    | (*%
        @format({var, arity}) var
       *)
      (*% @prefix formatWithType_
        @format({var, arity}) "TPRECFUNVAR(" !N0{ var:format_varInfo } ")"
       *)
      TPRECFUNVAR of
      {
        var : varInfo,
        arity : int
      }
    | (*%
        @format({argVarList:arg args, bodyTy, bodyExp, loc})
        R1{
          "fn" +d
          args:ifsingle()(,"{")
          args:N0ifnotsingle()(args(arg)("," +1))
          args:ifsingle()(,"}")
          +d "=>" +1 bodyExp
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      (* ty is the type of tpexp  *)
      TPFNM of
      {
        argVarList : varInfo list,
        bodyTy : ty,
        bodyExp : tpexp,
        loc : loc
      }
    | (*%
        @format({funExp, funTy, argExpList:arg args, loc})
        L8{
          funExp
          2[
            +1
            args:ifsingle()(,"{")
            args:N0ifnotsingle()(args(arg)("," +1))
            args:ifsingle()(,"}")
          ]
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      (* ty is the type of the function *)
      TPAPPM of
      {
        funExp : tpexp,
        funTy : ty,
        argExpList : tpexp list,
        loc : loc
      }
    | (*%
        @format({con, instTyList: ty tys tyo, argExpOpt: arg argOpt, loc})
        argOpt:ifsome()(
          L8{ con 2[ +1 argOpt(arg) ] },
          con
        )
       *)
      (*% @prefix formatWithType_
        @format({con, instTyList: ty tys tyo, argExpOpt: arg argOpt, loc})
        L8{
          con
          2[
            tyo:ifsome()(+1 "{" !N0{ tyo(tys(ty)("," +1)) } "}",)
            argOpt:ifsome()(2[ +1 argOpt(arg) ],)
          ]
        }
       *)
      TPDATACONSTRUCT of
      {
        con : conInfo,
        instTyList : ty list option, (* NONE means no instantiation occurs *)
        argExpOpt : tpexp option,
        loc : loc
      }
    | (*%
        @format({exn, argExpOpt: arg argOpt, loc})
        argOpt:ifsome()(
          L8{ exn 2[ +1 argOpt(arg) ] },
          exn
        )
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPEXNCONSTRUCT of
      {
       exn : exnCon,
       argExpOpt : tpexp option,
       loc : loc
      }
    | (*%
        @format({exnInfo, loc})
        exnInfo
       *)
      (*% @prefix formatWithType_
        @format({exnInfo, loc})
        L8{ "TPEXNTAG" 2[ +1 "(" !N0{ exnInfo } ")" ] }
       *)
      TPEXNTAG of
      {
        exnInfo : exnInfo,
        loc : loc
      }
    | (*%
        @format({exExnInfo, loc })
        exExnInfo
       *)
      (*% @prefix formatWithType_
        @format({exExnInfo, loc})
        L8{ "TPEXEXNTAG" 2[ +1 "(" !N0{ exExnInfo } ")" ] }
       *)
      TPEXEXNTAG of
      {
        exExnInfo : exExnInfo,
        loc : loc
      }
    | (*%
        @format({expList:exp exps, expTyList:ty tys, ruleList:rule rules,
                 ruleBodyTy, caseKind, loc})
        R1{
          {
            "case" caseKind
            2[
              +1
              exps:ifsingle()(,"{")
              exps:N0ifnotsingle()(exps(exp)("," +1))
              exps:ifsingle()(,"}")
              +1
              "of"
            ]
          }
          rules:ifcons()(+1,)
          rules(rule)(+1 "|" +d)
        }
        @format:rule({args:arg args, body})
        {
          args:ifsingle()(,"{")
          args:N0ifnotsingle()(args(arg)("," +1))
          args:ifsingle()(,"}")
          +d "=>" +1 body
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPCASEM of
      {
        expList : tpexp list,
        expTyList : ty list,
        ruleList : {args : tppat list, body : tpexp} list,
        ruleBodyTy : ty,
        caseKind : caseKind,
        loc : loc
      }
    | (*%
        @format({exp, expTy, ruleList, ruleBodyTy, defaultExp, loc})
        R1{
          { "switch" 2[ +1 exp +1 "of" ] }
          +1
          ruleList()(defaultExp)
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPSWITCH of
      {
        exp : tpexp,
        expTy : ty,
        ruleList : switch_rules,
        defaultExp : tpexp,
        ruleBodyTy : ty,
        loc : loc
      }
    | (*%
        @format({groupListTerm, groupListTy, dynamicTerm, dynamicTy, elemTy,
                 ruleBodyTy, loc})
        L8{
          "TPDYNAMICCASE"
          2[
            +1 "("
            !N0{
              "dynamicTerm" +d "=" 2[ +1 dynamicTerm ] ","
              "groupListTerm" +d "=" 2[ +1 groupListTerm ] ","
              "groupListTy" +d "=" 2[ +1 groupListTy ] ","
              "elemTy" +d "=" 2[ +1 elemTy ] ","
              "ruleBodyTy" +d "=" 2[ +1 ruleBodyTy ]
            }
            ")"
          ]
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPDYNAMICCASE of
      {
        groupListTerm : tpexp,
        groupListTy : ty,
        dynamicTerm :  tpexp,
        dynamicTy :  ty,
        elemTy : ty,
        ruleBodyTy : ty,
        loc : loc
      }
    | (*%
        @format({existInstMap, exp, expTy, instTyList:ty tys, loc})
        L8{
          exp
          2[
            +1
            "{" L8{ "TPDYNAMICEXISTTAPP" +1 "(" !N0{ existInstMap } ")" } "}"
          ]
        }
       *)
      (*% @prefix formatWithType_
        @format({existInstMap, exp, expTy, instTyList:ty tys, loc})
        L8{
          exp
          2[
            +1
            "{"
            !N0{
              L8{ "TPDYNAMICEXISTAPP" +1 "(" !N0{ existInstMap } ")" }
              tys:ifcons()("," +1,)
              tys(ty)("," +1)
            }
            "}"
          ]
        }
       *)
      TPDYNAMICEXISTTAPP of
      {
        existInstMap : tpexp,
        exp : tpexp,
        expTy : ty,
        instTyList : ty list,
        loc : loc
      }
    | (*%
        @format({primOp, instTyList:ty tys tyo, argExp, loc})
        L8{ primOp 2[ +1 argExp ] }
       *)
      (*% @prefix formatWithType_
        @format({primOp, instTyList:ty tys tyo, argExp, loc})
        L8{
          primOp
          2[
            tyo:ifsome()(+1 "{" !N0{ tyo(tys(ty)("," +1)) } "}",)
            +1 argExp
          ]
        }
       *)
      TPPRIMAPPLY of
      {
        primOp : primInfo,
        instTyList : ty list option,
        argExp : tpexp,
        loc : loc
      }
    | (*%
        @format({oprimOp, instTyList:ty tys, argExp, loc})
        L8{ oprimOp 2[ +1 argExp ] }
       *)
      (*% @prefix formatWithType_
        @format({oprimOp, instTyList:ty tys, argExp, loc})
        L8{
          oprimOp
          2[
            +1 "{" !N0{ tys(ty)("," +1) } "}"
            +1 argExp
          ]
        }
       *)
      TPOPRIMAPPLY of
      {
       oprimOp : oprimInfo,
       instTyList : ty list,
       argExp : tpexp,
       loc : loc
      }
    | (*%
        @format({fields: field fields, recordTy, loc})
        "{" !N0{ fields(field) } "}"
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPRECORD of
      {
        fields : tpexp RecordLabel.Map.map,
        recordTy : ty RecordLabel.Map.map,
        loc : loc
      }
    | (*%
        @format({label, exp, expTy, resultTy, loc})
        L8{ "#" label 2[ +1 exp ] }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPSELECT of
      {
        label : RecordLabel.label,
        exp : tpexp,
        expTy : ty,
        resultTy : ty,
        loc : loc
      }
    | (*%
        @format({label, recordExp, recordTy, elementExp, elementTy, loc})
        L8{
          recordExp
          2[
            +1 "#" +d "{"
            !N0{ label +d "=" 2[ +1 elementExp ] }
            "}"
          ]
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPMODIFY of
      {
        label : RecordLabel.label,
        recordExp : tpexp,
        recordTy : ty,
        elementExp : tpexp,
        elementTy : ty,
        loc : loc
      }
    | (*%
        @format({binds:bind binds, bodyExp, loc})
        N4{!N0{
          "monolet"
          2[
            binds:ifcons()(+1,)
            binds(bind)(+1)
          ]
          +1 "in"
          2[ +1 bodyExp ]
          +1 "end"
        }}
        @format:bind(var * exp)
        !R1{ var +d "=" 2[ +1 exp ] }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      (*
        The difference between MONOLET and LET is that
          MONOLET x = e1 in e2
        is non-expansive if both e1 and e2 are non-expansive, whereas
          LET val x = e1 in e2
        is always expansive.
       *)
      TPMONOLET of
      {
         binds : (varInfo * tpexp) list,
         bodyExp : tpexp,
         loc : loc
      }
    | (*%
        @format({decls:dec decs, body, loc})
        N4{!N0{
          "let"
          2[
            decs:ifcons()(+1,)
            decs(dec)(+1)
          ]
          +1 "in"
          2[ +1 body ]
          +1 "end"
        }}
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPLET of
      {
        decls : tpdecl list,
        body : tpexp,
        loc : loc
      }
    | (*%
        @format({exp, ty, loc})
        L7{ "raise" 2[ +1 exp ] }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPRAISE of
      {
        exp : tpexp,
        ty : ty,
        loc : loc
      }
    | (*%
        @format({exp, exnVar, handler, resultTy, loc})
        R1{ exp +1 "handle" +d exnVar +d "=>" 2[ +1 handler ] }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      (*
        handle (exp1, x, exp2)
         exp1 the expression to be evaluated normally
            x variable to received exception value
         exp2 the handler body using x
       *)
      TPHANDLE of
      {
        exp : tpexp,
        exnVar : varInfo,
        handler : tpexp,
        resultTy : ty,
        loc : loc
      }
    | (*%
        @format({catchLabel, argExpList: arg args, resultTy, loc})
        L8{
          "TPTHROW"
          +1 catchLabel
          +1
          args:ifsingle()(,"{")
          args:N0ifnotsingle()(args(arg)("," +1))
          args:ifsingle()(,"}")
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      (* lightweight exception that never unwind call stack *)
      TPTHROW of
      {
        catchLabel : FunLocalLabel.id,
        argExpList : tpexp list,
        resultTy : ty,
        loc : loc
      }
    | (*%
        @format({catchLabel, argVarList: arg args, catchExp, tryExp, resultTy,
                 loc})
        R1{
          tryExp
          +1
          "TPCATCH"
          +d catchLabel +d
          args:ifsingle()(,"{")
          args:N0ifnotsingle()(args(arg)("," +1))
          args:ifsingle()(,"}")
          +d "=>" 2[ +1 catchExp ]
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      (* lightweight exception that never unwind call stack *)
      TPCATCH of
      {
        catchLabel : FunLocalLabel.id,
        argVarList : varInfo list,
        catchExp : tpexp,
        tryExp : tpexp,
        resultTy : ty,
        loc : loc
      }
    | (*%
        @format({btvEnv, constraints, expTyWithoutTAbs, exp, loc})
        exp
       *)
      (*% @prefix formatWithType_
        @format({btvEnv, constraints, expTyWithoutTAbs, exp, loc})
        "[" !N0{ { btvEnv } "." +1 exp } "]"
       *)
      (* \forall t.e;  ty is the type of tpexp without type abstraction *)
      TPPOLY of
      {
        btvEnv : btvEnv,
        constraints : Types.constraint list,
        expTyWithoutTAbs : ty,
        exp : tpexp,
        loc : loc
      }
    | (*%
        @format({exp, expTy, instTyList:ty tys, loc})
        exp
       *)
      (*% @prefix formatWithType_
        @format({exp, expTy, instTyList:ty tys, loc})
        L8{ exp 2[ +1 "{" !N0{ tys(ty)("," +1) } "}" ] }
       *)
      (* TPTAPP(ex,ty1,tyl) : ty1 is the polytype, tyl are type args *)
      TPTAPP of
      {
        exp : tpexp,
        expTy : ty,
        instTyList : ty list,
        loc : loc
      }
    | (*%
        @format ({funExp, ffiTy, stubTy, loc})
        L8{
          "TPFFIIMPORT"
          2[
            +1 "("
            !N0{ funExp "," +1 ffiTy }
            ")"
          ]
        }
       *)
      (*% @prefix formatWithType_
        @format ({funExp, ffiTy, stubTy, loc})
        L2{
          L8{
            "TPFFIIMPORT"
            2[
              +1 "("
              !N0{ funExp "," +1 ffiTy }
              ")"
            ]
          }
          +1 ":" +d stubTy
        }
       *)
      TPFFIIMPORT of
      {
        funExp : tpffifun,
        ffiTy : ffiTy,
        stubTy : ty,
        loc : loc
      }
    | (*%
        @format({name, ty, loc})
        L8{ "TPFOREIGNSYMBOL" 2[ +1 "(" name ")" ] }
       *)
      (*% @prefix formatWithType_
        @format({name, ty, loc})
        L2{ L8{ "TPFOREIGNSYMBOL" 2[ +1 "(" name ")" ] } +1 ":" +d ty }
       *)
      TPFOREIGNSYMBOL of {name:string, ty:ty, loc:loc}
    | (*%
        @format({funExp, argExpList: arg args, attributes,
                 resultTy: retTy retTyOpt, loc})
        L8{
          "TPFOREIGNAPPLY"
          2[
            +1 funExp
            +1 "{" !N0{ args(arg)("," +1) } "}"
          ]
        }
       *)
      (*%
        @prefix formatWithType_
        @format({funExp, argExpList: arg args, attributes,
                 resultTy: retTy retTyOpt, loc})
        L2{
          L8{
            "TPFOREIGNAPPLY"
            2[
              +1 funExp
              +1 "{" !N0{ args(arg)("," +1) } "}"
            ]
          }
          +1 ":" +d retTyOpt:ifsome()(retTyOpt(retTy), "()")
        }
       *)
      TPFOREIGNAPPLY of
      {
        funExp : tpexp,
        argExpList : tpexp list,
        attributes : FFIAttributes.attributes,
        resultTy : ty option,
        loc : loc
      }
    | (*%
        @format({attributes, argVarList:arg args, resultTy, bodyExp, loc})
        R1{
          "TPCALLBACKFN" +d
          args:ifsingle()(,"{")
          args:N0ifnotsingle()(args(arg)("," +1))
          args:ifsingle()(,"}")
          +d "=>" +1 bodyExp
        }
       *)
      (*% @prefix formatWithType_
        @format({attributes, argVarList:arg args, resultTy: retTy retTyOpt,
                 bodyExp, loc})
        R1{
          "TPCALLBACKFN" +d
          args:ifsingle()(,"{")
          args:N0ifnotsingle()(args(arg)("," +1))
          args:ifsingle()(,"}")
          +d "=>" +1
          L2{ bodyExp +1 ":" +d retTyOpt:ifsome()(retTyOpt(retTy),"()") }
        }
       *)
      TPCALLBACKFN of
      {
        attributes : FFIAttributes.attributes,
        argVarList : varInfo list,
        bodyExp : tpexp,
        resultTy : ty option,
        loc : loc
      }
    | (*%
        @format((exp * expTy) * ty * loc)
        exp
       *)
      (*% @prefix formatWithType_
        @format((exp * expTy) * ty * loc)
        L2{
          L8{ "TPCAST" 2[ +1 "(" !N0{ exp } ")" ] }
          +1 ":" +d ty
        }
       *)
      (* cast e to some type ty; used to coerce con type to a record type *)
      TPCAST of (tpexp * ty) * ty * loc
    | (*%
        @format(ty * loc)
        L8{ "TPSIZEOF" 2[ +1 "(" !N0{ ty } ")" ] }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPSIZEOF of ty * loc
    | (*%
        @format({isJoin, ty, args:arg1 * arg2, argtys, loc})
        L8{
          "TPJOIN"
          2[
             +1 isJoin:iftrue()("_join", "_extend")
             +1 "(" !N0 { arg1 "," +1 arg2 } ")"
          ]
        }
       *)
      (*% @prefix formatWithType_
        @format({isJoin, ty, args:arg1 * arg2, argtys, loc})
        L2{
          L8{
            "TPJOIN"
            2[
               +1 isJoin:iftrue()("_join", "_extend")
               +1 "(" !N0 { arg1 "," +1 arg2 } ")"
            ]
          }
          +1 ":" +d ty
        }
       *)
      TPJOIN of
      {
        ty : ty,
        args : tpexp * tpexp,
        argtys : ty * ty,
        isJoin : bool,
        loc : loc
      }
    | (*%
        @format({exp, ty, elemTy, coerceTy, loc})
        N4{ "_dynamic" 2[ +1 exp ] +1 "as" +d coerceTy }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPDYNAMIC of
      {
        exp : tpexp,
        ty : ty,
        elemTy : ty,
        coerceTy : ty,
        loc : loc
      }
    | (*%
        @format({exp, ty, elemTy, coerceTy, loc})
        N4{ "_dynamic" 2[ +1 exp ] +1 "is" +d coerceTy }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPDYNAMICIS of
      {
        exp : tpexp,
        ty : ty,
        elemTy : ty,
        coerceTy : ty,
        loc : loc
      }
    | (*%
        @format({exp, ty, elemTy, coerceTy, loc})
        N4{ "_dynamicview" 2[ +1 exp ] +1 "is" +d coerceTy }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPDYNAMICVIEW of
      {
        exp : tpexp,
        ty : ty,
        elemTy : ty,
        coerceTy : ty,
        loc : loc
      }
    | (*%
        @format({ty, coerceTy, loc})
        N4{ "_dynamicnull" +1 "as" +d ty }
       *)
      (*% @prefix formatWithType_
        @format({ty, coerceTy, loc})
        L2{ N4{ "_dynamicnull" +1 "as" +d ty } +1 ":" +d coerceTy }
       *)
      TPDYNAMICNULL of
      {
        ty : ty,
        coerceTy : ty,
        loc : loc
      }
    | (*%
        @format({ty, coerceTy, loc})
        N4{ "_dynamictop" +1 "as" +d ty }
       *)
      (*% @prefix formatWithType_
        @format({ty, coerceTy, loc})
        L2{ N4{ "_dynamictop" +1 "as" +d ty } +1 ":" +d coerceTy }
       *)
      TPDYNAMICTOP of
      {
        ty : ty,
        coerceTy : ty,
        loc : loc
      }
    | (*%
        @format(ty * loc)
        L2{ "_reifyTy" +1 "(" !N0{ ty } ")" }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPREIFYTY of ty * loc

  and tpffifun
    = (*% @format(x * ty) x *)
      (*% @prefix formatWithType_ @format(x * ty) x *)
      TPFFIFUN of tpexp * ty
    | (*% @format(x) x *)
      (*% @prefix formatWithType_ @format(x) x *)
      TPFFIEXTERN of string

  and (*% @params(defaultExp) *)
      switch_rules =
      (*%
        @format(rule rules)
        rules(rule)(+1 "|" +d)
        rules:ifcons()(+1 "|" +d,)
        { "_" +d "=>" +1 defaultExp }
        @format:rule({const, ty, body})
        { const +d "=>" +1 body }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      CONSTCASE of {const : constant, ty : ty, body : tpexp} list
    | (*%
        @format(rule rules)
        rules(rule)(+1 "|" +d)
        rules:ifcons()(+1 "|" +d,)
        { "_" +d "=>" +1 defaultExp }
        @format:rule({con, instTyList, argVarOpt: arg args, body})
        { args:ifsome()(L8{ con +1 args(arg) }, con) +d "=>" +1 body }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      CONCASE of {con : conInfo,
                  instTyList : ty list option,
                  argVarOpt : varInfo option,
                  body : tpexp} list
    | (*%
        @format(rule rules)
        rules(rule)(+1 "|" +d)
        rules:ifcons()(+1 "|" +d,)
        { "_" +d "=>" +1 defaultExp }
        @format:rule({exn, argVarOpt: arg args, body})
        { args:ifsome()(L8{ exn +1 args(arg) }, exn) +d "=>" +1 body }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      EXNCASE of {exn : exnCon,
                  argVarOpt : varInfo option,
                  body : tpexp} list

  and tpdecl
    = (*%
        @format((var * exp) * loc)
        { "val" +d var +d "=" 2[ +1 exp ] }
       *)
      (*% @prefix formatWithType_
        @format((var * exp) * loc)
        { "val" +d var:format_varInfo +d "=" 2[ +1 exp ] }
       *)
      TPVAL of (varInfo * tpexp) * loc
    | (*%
        @format(bind binds * loc)
        {
          "fun"
          binds(bind)(+1 "and")
        }
        @format:bind({funVarInfo, argTyList, bodyTy, ruleList:rule rules})
        2[
          +1
          !R1{
            !N4{ funVarInfo }
            rules:ifcons()(+1,)
            rules(rule)(+1 "|" +d)
          }
        ]
        @format:rule({args:pat pats, body})
        {
          pats:ifsingle()(,"{")
          pats:N0ifnotsingle()(pats(pat)("," +1))
          pats:ifsingle()(,"}")
          +d "=" +1 body
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPFUNDECL of
      {
        funVarInfo: varInfo,
        argTyList: ty list,
        bodyTy: ty,
        ruleList : {args:tppat list, body:tpexp} list
      } list
      * loc
    | (*%
        @format({btvEnv, constraints, recbinds: bind binds, loc})
        {
          "fun"
          binds(bind)(+1 "and")
        }
        @format:bind({funVarInfo, argTyList, bodyTy, ruleList:rule rules})
        2[
          +1
          !R1{
            !N4{ funVarInfo }
            rules:ifcons()(+1,)
            rules(rule)(+1 "|" +d)
          }
        ]
        @format:rule({args:pat pats, body})
        {
          pats:ifsingle()(,"{")
          pats:N0ifnotsingle()(pats(pat)("," +1))
          pats:ifsingle()(,"}")
          +d "=" +1 body
        }
       *)
      (*% @prefix formatWithType_
        @format({btvEnv, constraints, recbinds: bind binds, loc})
        {
          "fun" +d "[" !N0{ btvEnv } "]"
          binds(bind)(+1 "and")
        }
        @format:bind({funVarInfo, argTyList, bodyTy, ruleList:rule rules})
        2[
          +1
          !R1{
            !N4{ funVarInfo }
            rules:ifcons()(+1,)
            rules(rule)(+1 "|" +d)
          }
        ]
        @format:rule({args:pat pats, body})
        {
          pats:ifsingle()(,"{")
          pats:N0ifnotsingle()(pats(pat)("," +1))
          pats:ifsingle()(,"}")
          +d "=" +1 body
        }
       *)
      TPPOLYFUNDECL of
      {
        btvEnv : btvEnv,
        constraints : Types.constraint list,
        recbinds : {funVarInfo: varInfo,
                    argTyList: ty list,
                    bodyTy: ty,
                    ruleList : {args:tppat list, body:tpexp} list
                   } list,
        loc : loc
      }
    | (*%
        @format(bind binds * loc)
        {
          "val" +d "rec"
          binds(bind)(+1 "and")
        }
        @format:bind({var, exp})
        2[ +1 !R1{ var +d "=" 2[ +1 exp ] } ]
       *)
      (*% @prefix formatWithType_
        @format(bind binds * loc)
        {
          "val" +d "rec"
          binds(bind)(+1 "and")
        }
        @format:bind({var, exp})
        2[ +1 !R1{ var +1 +d "=" 2[ +1 exp ] } ]
       *)
      TPVALREC of {var : varInfo, exp : tpexp} list * loc
    | (*%
        @format({btvEnv, constraints, recbinds: bind binds, loc})
        {
          "val" +d "rec"
          binds(bind)(+1 "and")
        }
        @format:bind({var, exp})
        2[ +1 !R1{ var +d "=" 2[ +1 exp ] } ]
       *)
      (*% @prefix formatWithType_
        @format({btvEnv, constraints, recbinds: bind binds, loc})
        {
          "val" +d "rec" +d "[" !N0{ btvEnv } "]"
          binds(bind)(+1 "and")
        }
        @format:bind({var, exp})
        2[ +1 !R1{ var +d "=" 2[ +1 exp ] } ]
       *)
      TPVALPOLYREC of
      {
        btvEnv : btvEnv,
        constraints : Types.constraint list,
        recbinds : {var:varInfo, exp:tpexp} list,
        loc : loc
      }
    | (*%
        @format(exnInfo * loc)
        { "exception" +d exnInfo }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPEXD of exnInfo * loc
    | (*%
        @format({exnInfo, varInfo} * loc)
        { "_exceptiontag" +d exnInfo +d "=" 2[ +1 varInfo ] }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPEXNTAGD of {exnInfo : exnInfo, varInfo : varInfo} * loc
    | (*%
        @format({var, exp})
        { "export" +d var +d "=" 2[ +1 exp ] }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPEXPORTVAR of {var : exVarInfo, exp : tpexp}
    | (*%
        @format(exn)
        "export" +d "exception" +d exn
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      (* export exception declaration specified in  _interface *)
      TPEXPORTEXN of exnInfo
    | (*%
        @format({path, ty} * provider)
        "extern" +d path
       *)
      (*% @prefix formatWithType_
        @format({path, ty} * provider)
        "extern" +d L2{ path +1 ":" +d ty }
       *)
      TPEXTERNVAR of {path : longsymbol, ty : ty} * Types.provider
    | (*%
        @format({path, ty:ty} * provider)
        "extern" +d "exception" +d path
       *)
      (*% @prefix formatWithType_
        @format({path, ty:ty} * provider)
        "extern" +d L2{ "exception" +d path +1 ":" +d ty }
       *)
      (* import exception declaration specified in  _interface *)
      TPEXTERNEXN of {path : longsymbol, ty : ty} * Types.provider
    | (*%
        @format({path, ty})
        "builtin" +d "exception" +d path
       *)
      (*% @prefix formatWithType_
        @format({path, ty})
        "builtin" +d L2{ "exception" +d path +1 ":" +d ty }
       *)
      (* builtin exception definition *)
      TPBUILTINEXN of {path : longsymbol, ty : ty}

  and tppat
    = (*%
        @format(v * loc) "TPPATERROR"
       *)
      (*% @prefix formatWithType_
        @format(v * loc) "TPPATERROR"
       *)
      TPPATERROR of ty * loc
    | (*%
        @format(v) "_"
       *)
      (*% @prefix formatWithType_
        @format(v) "_"
       *)
      TPPATWILD of ty * loc
    | (*%
        @format(var) var
       *)
      (*% @prefix formatWithType_
        @format(var) var
       *)
      TPPATVAR of varInfo
    | (*%
        @format(const * ty * loc) const
       *)
      (*% @prefix formatWithType_
        @format(const * ty * loc) const
       *)
      TPPATCONSTANT of constant * ty * loc
    | (*%
        @format({conPat, instTyList, argPatOpt:arg argOpt, patTy, loc})
        L8{
          conPat
          2[
            argOpt:ifsome()(+1,)
            argOpt(arg)
          ]
        }
       *)
      (*% @prefix formatWithType_
        @format({conPat, instTyList:ty tys tyo, argPatOpt:arg argOpt, patTy,
                 loc})
        L8{
          conPat
          2[
            tyo:ifsome()(+1 "{" !N0{ tyo(tys(ty)("," +1)) } "}",)
            argOpt:ifsome()(+1,)
            argOpt(arg)
          ]
        }
       *)
      TPPATDATACONSTRUCT of
      {
        conPat : conInfo,
        instTyList : ty list option,
        argPatOpt : tppat option,
        patTy : ty,
        loc : loc
      }
    | (*%
        @format({exnPat, argPatOpt:arg argOpt, patTy, loc})
        L8{
          exnPat
          2[
            argOpt:ifsome()(+1,)
            argOpt(arg)
          ]
        }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPPATEXNCONSTRUCT of
      {
        exnPat : exnCon,
        argPatOpt : tppat option,
        patTy : ty,
        loc : loc
      }
    | (*%
        @format({fields: field fields, recordTy, loc})
        "{" !N0{ fields(field) } "}"
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPPATRECORD of
      {
        fields : tppat RecordLabel.Map.map,
        recordTy : ty,
        loc : loc
      }
    | (*%
        @format({varPat, asPat, loc})
        N1{ varPat +1 "as" +d asPat }
       *)
      (*% @prefix formatWithType_
        @ditto
       *)
      TPPATLAYERED of
      {
        varPat : tppat,
        asPat : tppat,
        loc : loc
      }

  fun tppatToLoc tppat =
      case tppat of
        TPPATERROR (ty, loc) => loc
      | TPPATWILD (ty, loc) => loc
      | TPPATVAR varInfo => Symbol.longsymbolToLoc (#path varInfo)
      | TPPATCONSTANT (constant, ty, loc) => loc
      | TPPATDATACONSTRUCT {loc, ...} => loc
      | TPPATEXNCONSTRUCT {loc, ...} => loc
      | TPPATRECORD {loc, ...} => loc
      | TPPATLAYERED {loc, ...} => loc

end
